
finp$="picture.jpg"

'- this part reads the .png file format as binary, and gets its size
finptm$=finp$+"_t.png":shell("convert "+finp$+" "+finptm$ )
xed=0:yed=0:open finptm$ for input as #1:for i=1 to 16:n=readbyte(1):next:for i=1 to 2:n=readbyte(1):next
xed=readbyte(1)*256:xed=xed+readbyte(1):for i=1 to 2:n=readbyte(1):next:yed=readbyte(1)*256:yed=yed+readbyte(1)
close #1:shell("rm "+finptm$ )


'- canvas height has 2 pixels more than original picture size, for conversion buffer area
setdisplay(xed,yed+2,32,1):paper(8^8-1):ink(0):pen(0):cls:loadimage(finp$,1):pasteicon(0,0,1)


'- defines halftone cluster
dim clust[8,8] '-,o4b[2]
' a$="00,12,03,15,08,04,11,07,02,14,01,13,10,06,09,05"
  a$="00,06,08,14,02,12,04,10,08,14,00,06,04,10,02,12"
for y2=0 to 3:for x2=0 to 3:lc=(y2*4)+x2
clust[x2,y2]=val(mid$(a$,(lc*3)+1,2))
next:next


'- this part converts the hole picture into a 8-colour one
dim cor[16]
cor[0]=0x000000:cor[1]=0x0000FF
cor[2]=0xFF0000:cor[3]=0xFF00FF
cor[4]=0x00FF00:cor[5]=0x00FFFF
cor[6]=0xFFFF00:cor[7]=0xFFFFFF
for y=0 to yed
  for xq=0 to xed
     ind=point(xq,y)
     b= ind mod 256: ind=int(ind/256)
     g= ind mod 256: ind=int(ind/256)
     r= ind mod 256
     patgf=(((clust[xq mod 4,y mod 4]+1)*255)/16)
     rpat=0:if r>patgf then:rpat=1:end if
     gpat=0:if g>patgf then:gpat=1:end if
     bpat=0:if b>patgf then:bpat=1:end if
     o4b=(bpat+(rpat*2)+(gpat*4)) mod 8
     ink(cor[o4b]):dot(xq,y)
     next:next 

'- 'corrects' the colour reading

'- this part writes in the 'buffer line (yed)' of the canvas 
'-   a binary interpretation of the 8-colour picture, a bit in the AppleII way
'-   the left 'multiple-of-7' part will be with the picture source width,
'-   and the '1/8' part of the AppleII colour flag (switches between magenta/green and orange/blue) will be in the right


for y=0 to yed
  v0=0
  for x1=0 to int(xed/7)+1
    cflc=0
    for x2=0 to 6
      x=x2+(x1*7)
      apv=0 : cfl=0
      ind=point(x,y)
      b= ind mod 256: ind=int(ind/256)
      g= ind mod 256: ind=int(ind/256)
      r= ind mod 256
      prim= (int(g/128))*4 +(int(r/128))*2 +(int(b/128)) 
      if prim=0 then : apv=0 : cfl=1 : end if             '- black
      if prim=3 then : apv=1 : cfl=0 : end if             '- magenta
      if prim=1 or prim=5 then : apv=1 : cfl=2 : end if   '- blue
      if prim=4 then : apv=2 : cfl=0 : end if             '- green
      if prim=2 or prim=6 then : apv=2 : cfl=2 : end if   '- orange
      if prim=7 then : apv=3 : cfl=1 : end if             '- white
      if(x mod 2)=0 then 
        if apv=0 or apv=2 then
          ink(0):dot (x,yed)
          end if 
        if apv=0 or apv=1 then 
          ink(0):dot (x+1,yed)
          end if
        end if 
      cflc=cflc+cfl
      next
    if cflc<8 then
      ink(0):dot(x1,yed+1)
      end if 
    next


'- buffer cleaning
  ink(0):line(0,y,xed-1,y)


'- this part will 'correct' the binary information, from the 'buffer line (yed)'
'-   to the 'y' line, which will try to make a display close to what AppleII would display
'-   this part makes the white pixels only the ones has neigbour white pictures, and the same for black pixels, etc...
'-   the 'colour burst' simulation is all done in this part (as far i can remember)


  ink(0xFF00FF)
  for x=0 to xed-1 step 2
    i=point(x,yed) mod 256
    if i>127 then:dot(x,y): end if
    next
  ink(0x00FF00)
  for x=1 to xed-1 step 2
    i=point(x,yed) mod 256
    if i>127 then:dot(x,y): end if
    next
  ink(0xFF00FF)
  for x=0 to xed-1 step 2
    i1=point(x,yed) mod 256:i2=point(x+2,yed) mod 256
    if i1>127 and i2>127 then:dot(x+1,y): end if
    next
  ink(0x00FF00)
  for x=1 to xed-1 step 2
    i1=point(x,yed) mod 256:i2=point(x+2,yed) mod 256
    if i1>127 and i2>127 then:dot(x+1,y): end if
    next
  ink(0xFFFFFF)
  for x=1 to xed-1
    i1=point(x,yed) mod 256:i2=point(x+1,yed) mod 256
    if i1>127 and i2>127 then:dot(x,y):dot(x+1,y): end if
    next
  ink(0x000000)
  for x=1 to xed-1
    i0=point(x,y):i1=point(x+1,y):i2=point(x+2,y)
    if i0=0xFFFFFF and i2=0xFFFFFF and i1<>0xFFFFFF then:dot(x+1,y): end if
    next


'- this part will correct the 'buffer line 2' with the colour flag switch (between magenta/green and orange/blue)

  for x1=0 to int(xed/7)+1
    q=point(x1,yed+1) mod 256
    for x2=0 to 6
      n=point(x1*7+x2,y)
      if n=0xFF00FF and q>128 then: n=0x0000FF: end if
      if n=0x00FF00 and q>128 then: n=0xFF7F00: end if
      ink(n):dot(x1*7+x2,y)
      next
    next


'- buffer cleaning
  ink(0xffffff):line(0,yed,xed,yed)
  ink(0xffffff):line(0,yed+1,xed,yed+1)

  next


'- saves the resulting picture
fout$=finp$+".bmp":fout2$=finp$+".png":grab(1,0,0,xed,yed):saveimage(fout$,1):shell("convert "+fout$+" "+fout2$+" && rm "+fout$ )



